home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / pcboard / tickle16.zip / REPORT.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1996-10-04  |  6KB  |  244 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 3.1O (Encryption type I) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Integer  INTEGER001
  20.     Integer  INTEGER002
  21.     Real     REAL001
  22.     Real     REAL002
  23.     Real     REAL003
  24.     Real     REAL004
  25.     Real     REAL005
  26.     String   TSTRING001(49)
  27.     String   STRING002
  28.     Int      INT001
  29.     Int      INT002
  30.  
  31. ;------------------------------------------------------------------------------
  32.  
  33.     Gosub LABEL001
  34.     If (DErr(0)) Then
  35.         Newline
  36.         PrintLn "Cannot open TICKLE.DBF (DataBase) - Aborting"
  37.         Newline
  38.         Log "Cannot open TICKLE.DBF (DataBase) - Aborting", 0
  39.         Wait
  40.         End
  41.     Endif
  42.     StartDisp 1
  43.     FAppend 1, PPEPath() + "TKLREPRT.LOG", 2, 0
  44.     FPutLn 1, "───────────────────────────────────────────────────-"
  45.     FPutLn 1, "REPORT.PPE - A 'Tickle File' Database Report Program"
  46.     FPutLn 1, ""
  47.     FPutLn 1, "          Written by:  Dan Shore - SysOp"
  48.     FPutLn 1, "                       The Shoreline BBS"
  49.     FPutLn 1, ""
  50.     FPutLn 1, "          Copyright 1995,1996 (c) - Dan Shore"
  51.     FPutLn 1, ""
  52.     INTEGER002 = DRecCount(0)
  53.     While (INTEGER001 < INTEGER002) Do
  54.         Inc INTEGER001
  55.         DGo 0, INTEGER001
  56.         If (DErr(0)) Break
  57.         STRING002 = DGet(0, DName(0, 1))
  58.         STRING002 = Trim(STRING002, " ")
  59.         STRING002 = Mixed(STRING002)
  60.         PrintLn "Processing UserName: ", STRING002
  61.         Inc REAL002
  62.         INT002 = 0
  63.         FPutLn 1, "──────────────────────────────────────────────────────────────────────"
  64.         FPut 1, STRING002 + " has "
  65.         STRING002 = DGet(0, DName(0, 2))
  66.         If (DDeleted(0)) Then
  67.             FPutLn 1, "-* been flagged for Deletion *- "
  68.             Inc REAL005
  69.             Continue
  70.         ElseIf (DGet(0, DName(0, 2)) == "            ") Then
  71.             FPutLn 1, "-* NO FILES *- in their database"
  72.             Inc REAL005
  73.             Continue
  74.         Else
  75.             FPutLn 1, "these files in their database:"
  76.             FPutLn 1, ""
  77.             Inc REAL004
  78.         Endif
  79.         For INT001 = 2 To 25
  80.             If (DGet(0, DName(0, INT001)) == "            ") Then
  81.                 FPutLn 1, ""
  82.                 FPutLn 1, ""
  83.                 Break
  84.             Endif
  85.             Inc REAL003
  86.             Inc INT002
  87.             STRING002 = Space(2 - Len(String(INT001 - 1))) + String(INT001 - 1) + ".  " + DGet(0, DName(0, INT001)) + Space(2)
  88.             FPut 1, STRING002
  89.             STRING002 = Lower(DGet(0, DName(0, INT001 + 24)))
  90.             FPut 1, STRING002 + Space(1)
  91.             If (INT002 % 2 == 0) Then
  92.                 FPutLn 1, ""
  93.                 INT002 = 0
  94.             Endif
  95.         Next
  96.     EndWhile
  97.     FPutLn 1, "──────────────────────────────────────────────────────────────────────"
  98.     FPutLn 1, ""
  99.     FPutLn 1, ""
  100.     FPutLn 1, "     ************************************************************"
  101.     FPutLn 1, ""
  102.     FPutLn 1, "                'Tickle File' Statistics Summary Report"
  103.     FPutLn 1, ""
  104.     FPutLn 1, ""
  105.     FPutLn 1, "                         Total Users in Database : " + String(REAL002)
  106.     FPutLn 1, "                         Total Files in Database : " + String(REAL003)
  107.     FPutLn 1, "              Total Users with Files in Database : " + String(REAL004)
  108.     FPutLn 1, "           Total Users without Files in Database : " + String(REAL005)
  109.     REAL001 = REAL003 / REAL004
  110.     FPutLn 1, "           Files Per User with Files in Database : " + String(REAL001)
  111.     FPutLn 1, ""
  112.     FPutLn 1, "     ************************************************************"
  113.     FClose 1
  114.     StartDisp 2
  115.     End
  116.     :LABEL001
  117.     If (Exist(PPEPath() + "tickle.dbf")) Goto LABEL002
  118.     TSTRING001(0) = "usr_name,C,25,0"
  119.     TSTRING001(1) = "file1,C,12,0"
  120.     TSTRING001(2) = "file2,C,12,0"
  121.     TSTRING001(3) = "file3,C,12,0"
  122.     TSTRING001(4) = "file4,C,12,0"
  123.     TSTRING001(5) = "file5,C,12,0"
  124.     TSTRING001(6) = "file6,C,12,0"
  125.     TSTRING001(7) = "file7,C,12,0"
  126.     TSTRING001(8) = "file8,C,12,0"
  127.     TSTRING001(9) = "file9,C,12,0"
  128.     TSTRING001(10) = "file10,C,12,0"
  129.     TSTRING001(11) = "file11,C,12,0"
  130.     TSTRING001(12) = "file12,C,12,0"
  131.     TSTRING001(13) = "file13,C,12,0"
  132.     TSTRING001(14) = "file14,C,12,0"
  133.     TSTRING001(15) = "file15,C,12,0"
  134.     TSTRING001(16) = "file16,C,12,0"
  135.     TSTRING001(17) = "file17,C,12,0"
  136.     TSTRING001(18) = "file18,C,12,0"
  137.     TSTRING001(19) = "file19,C,12,0"
  138.     TSTRING001(20) = "file20,C,12,0"
  139.     TSTRING001(21) = "file21,C,12,0"
  140.     TSTRING001(22) = "file22,C,12,0"
  141.     TSTRING001(23) = "file23,C,12,0"
  142.     TSTRING001(24) = "file24,C,12,0"
  143.     TSTRING001(25) = "desc1,C,15,0"
  144.     TSTRING001(26) = "desc2,C,15,0"
  145.     TSTRING001(27) = "desc3,C,15,0"
  146.     TSTRING001(28) = "desc4,C,15,0"
  147.     TSTRING001(29) = "desc5,C,15,0"
  148.     TSTRING001(30) = "desc6,C,15,0"
  149.     TSTRING001(31) = "desc7,C,15,0"
  150.     TSTRING001(32) = "desc8,C,15,0"
  151.     TSTRING001(33) = "desc9,C,15,0"
  152.     TSTRING001(34) = "desc10,C,15,0"
  153.     TSTRING001(35) = "desc11,C,15,0"
  154.     TSTRING001(36) = "desc12,C,15,0"
  155.     TSTRING001(37) = "desc13,C,15,0"
  156.     TSTRING001(38) = "desc14,C,15,0"
  157.     TSTRING001(39) = "desc15,C,15,0"
  158.     TSTRING001(40) = "desc16,C,15,0"
  159.     TSTRING001(41) = "desc17,C,15,0"
  160.     TSTRING001(42) = "desc18,C,15,0"
  161.     TSTRING001(43) = "desc19,C,15,0"
  162.     TSTRING001(44) = "desc20,C,15,0"
  163.     TSTRING001(45) = "desc21,C,15,0"
  164.     TSTRING001(46) = "desc22,C,15,0"
  165.     TSTRING001(47) = "desc23,C,15,0"
  166.     TSTRING001(48) = "desc24,C,15,0"
  167.     DCreate 0, PPEPath() + "tickle", 0, TSTRING001(BOOLEAN000)
  168.     Goto LABEL003
  169.     :LABEL002
  170.     DOpen 0, PPEPath() + "tickle", 0
  171.     :LABEL003
  172.     Return
  173.  
  174. ;------------------------------------------------------------------------------
  175. ;
  176. ; Usage report (before postprocessing)
  177. ;
  178. ; ■ Statements used :
  179. ;
  180. ;    2       End
  181. ;    1       Wait
  182. ;    17      Goto 
  183. ;    61      Let 
  184. ;    2       PrintLn 
  185. ;    9       If 
  186. ;    1       FAppend 
  187. ;    1       FClose 
  188. ;    3       FPut 
  189. ;    31      FPutLn 
  190. ;    2       StartDisp 
  191. ;    1       Log 
  192. ;    1       Gosub 
  193. ;    1       Return
  194. ;    7       Inc 
  195. ;    2       Newline
  196. ;    1       DCreate 
  197. ;    1       DOpen 
  198. ;    1       DGo 
  199. ;
  200. ;
  201. ; ■ Functions used :
  202. ;
  203. ;    1       /
  204. ;    1       %
  205. ;    17      +
  206. ;    3       -
  207. ;    3       ==
  208. ;    2       <
  209. ;    1       <=
  210. ;    2       >=
  211. ;    8       !
  212. ;    2       &&
  213. ;    1       ||
  214. ;    1       Len(
  215. ;    1       Lower()
  216. ;    3       Space()
  217. ;    1       Trim()
  218. ;    7       String()
  219. ;    4       PPEPath()
  220. ;    1       Exist()
  221. ;    1       Mixed()
  222. ;    1       DDeleted()
  223. ;    2       DErr()
  224. ;    6       DName()
  225. ;    1       DRecCount()
  226. ;    6       DGet()
  227. ;
  228. ;------------------------------------------------------------------------------
  229. ;
  230. ; Analysis flags : No flag
  231. ;
  232. ;------------------------------------------------------------------------------
  233. ;
  234. ; Postprocessing report
  235. ;
  236. ;    1       For/Next
  237. ;    1       While/EndWhile
  238. ;    5       If/Then or If/Then/Else
  239. ;    0       Select Case
  240. ;
  241. ;------------------------------------------------------------------------------
  242. ;                 AEGiS Corp - Break the routines, code against the machines!
  243. ;------------------------------------------------------------------------------
  244.